home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™94 / Talks & Papers / Timothy Knox / yerk 3.66 / tool+ / listMan next >
Text File  |  1994-06-24  |  7KB  |  231 lines
  1. \ list manager routines - window used for maintaining a scrollable list
  2. \ 6/29/92    rfl    fixed bug by allowing IMOD to be seen in scroll pane
  3. \ 5/23/93    rfl removed new: modlist...don't want this to happen during module compile
  4. \                also don't include imod itself.
  5. \ 6.26.93    rfl    fixed bug when clicking at edge of scrollbar..14 to 15 in setrect:
  6. \ 1/15/94    rfl    modified fillcol for new installmod code
  7.  
  8. \ NEED TO PROTECT FOR 32K LIMIT
  9.  
  10. \ : within { x lo hi -- b }
  11. \    x hi >= x lo <= and ;
  12.  
  13. \ generic class of windows that includes a pane of scrolling text
  14. :CLASS TscrollWind <super ctlwind
  15.  
  16.     handle    lhandle        \ handle to list
  17.     rect     rview        \ scrollable area
  18.     rect    pane        \ rview plus scroll bar
  19. \    rect     databounds    \ always 1 column
  20.     int        theFont
  21.     int        fontSize
  22.     int        usage        \ how to respond to shift, command, etc.
  23.     int        AutoScroll    \ if true, then when new item is printed, scroll to it immediately
  24.     point    theCell        \ to determine if a cell is selected...col,row
  25.  
  26. \ **********************
  27. \ INIT METHODS
  28.  
  29.   :M setRect: put: rview get: rview swap 15 + swap put: pane
  30.     -1 -1 inset: pane ;M
  31.  
  32.   :M setListFont: put: fontSize put: theFont ;M
  33.   :M setUsage: put: usage ;M
  34.   :M restoreFont: get: theFont tfont get: fontSize tsize ;M
  35.   :M autoScroll: ( n --) put: autoscroll ;M
  36.  
  37. \ **********************
  38.  
  39. \ sets selflags
  40.   :M usage: get: usage get: lhandle -dup IF >ptr 36 + c! THEN ;M
  41.  
  42.   :M newList: get: theFont tfont get: fontSize tsize
  43.     0 abs: rview 0 0 1 0 put: tempRect abs: tempRect
  44.     size: rview drop 0 pack
  45.     word0 abs: self
  46.     true bool                 \ drawit
  47.     get: growFlg bool         \ growbox?
  48.     false bool true bool     \ no horizontal scroll, yes vert scroll
  49.     call lnew put: lhandle usage: self ;M
  50.  
  51.   :M new: alive: self not IF new: super newList: self ELSE select: self THEN -curs ;M
  52.  
  53.   :M getnew: alive: self not IF getnew: super newList: self ELSE select: self THEN -curs ;M
  54.  
  55.   :M closeList: get: lhandle call ldispose clear: lhandle ;M
  56.  
  57.   :M close: alive: self IF closeList: self close: super THEN ;M
  58.  
  59.   :M draw: pushPort set: self restoreFont: self
  60.     ^base 24 + @ get: lhandle call lupdate draw: pane popPort
  61.     draw: super ;M
  62.  
  63. \  :M addCols: { count -- }
  64. \    w0 count makeint 0 makeint get: lhandle call laddcolumn i->l drop ;M
  65.  
  66.   :M NRows: ( -- n) ptr: lhandle 84 + w@ 2/ ;M
  67.  
  68.   :M addRows: { count row# -- }
  69.     word0 count makeint row# makeint get: lhandle call lAddRow i->l drop ;M
  70.  
  71. ( -- x )
  72.   :M SelectedCell: 0 get: lhandle call LLastClick unpack swap drop ;M
  73.  
  74. ( tf -- )
  75.   :M drawing: { drawIt -- } get: lhandle
  76.     IF drawIt bool get: lhandle call LDoDraw THEN ;M 
  77.  
  78. \ replaces text and cell index
  79.   :M putText: { addr len index -- }
  80.     addr +base len makeint 0 index pack get: lhandle call lSetCell ;M
  81.  
  82. \ concatenates text to current row 
  83.   :M addText: { addr len -- } alive: self
  84.     IF addr +base len 255 min
  85.         makeint 0 Nrows: self 1- pack get: lhandle call laddtocell
  86.     THEN ;M
  87.  
  88. ( -- addr len ) \ get text that was selected
  89.   :M getText: pad +base dup 2+ swap 0 selectedCell: self pack
  90.         get: lhandle call LgetCell pad 1+ count ;M
  91.  
  92. \ positions list so that selected cell is visible
  93.   :M position: get: autoScroll IF get: lhandle call lAutoScroll THEN ;M
  94.  
  95. \ selects the nth item in the list if flag=true;deselect if flag=false
  96.   :M selectCell: { flag index -- } flag bool  0 index pack get: lhandle
  97.         call lSetSelect position: self ;M
  98.  
  99.   :M hilite: { index -- } 1 index selectCell: self ;M
  100.   :M nohilite: { index -- } 0 index selectCell: self ;M
  101.  
  102. \ puts text to new row at end of list, hilites it, and scrolls down
  103.   :M newText: { addr len \ #rows -- }
  104.     Nrows: self -> #rows
  105.     1 #rows addRows: self addr len #rows putText: self
  106.     #rows hilite: self position: self #rows nohilite: self ;M
  107.  
  108.   :M IsCellSelected: ( ind --) 0 swap put: theCell
  109.         0 makeint true makeint abs: theCell get: lhandle call lGetSelect i->l ;M
  110.  
  111.   :M lHandle: get: lhandle ;M
  112.  
  113.   :M classinit: classinit: super 'c null put: draw true put: autoScroll ;M
  114.  
  115. ;CLASS
  116.  
  117. control SelectBut    \ the ok button
  118. control    NoneBut
  119. control AllBut
  120. control defaultBut
  121.  
  122. :CLASS listWind <super TscrollWind
  123.  
  124.     var        dblAct        \ what to do on dblClick
  125.     var        act1        \ what to do if a cell is selected
  126.  
  127. \ **********************
  128. \ INIT METHODS
  129.  
  130.   :M dblAction: put: dblAct ;M
  131.   :M putMyAct: put: act1 ;M
  132. \ **********************
  133.  
  134. ( --tf)
  135.   :M ptInArea: where: themouse pack Ptin: pane ;M
  136.  
  137.   :M  CONTENT:  active: self
  138.         IF  ptInArea: self
  139.             IF    word0 where: fevent g->l mods: fevent makeint
  140.                 get: lhandle call lclick i->l        \ if true, dblclick
  141.                 selectedCell: self 0< not
  142.                 IF exec: act1 THEN                    \ enable buttons if cell selected
  143.                 IF exec: dblAct THEN
  144.             ELSE ^base ctlHit?  not
  145.                  IF exec: content THEN
  146.             THEN
  147.         ELSE  (abs) call SelectWindow
  148.         THEN ;M
  149.  
  150. \ if it's a cr then accept the selections and exit
  151.   :M key: $ 000000ff and 13 = IF 1 exec: SelectBut ELSE errbeep THEN ;M
  152.  
  153.   :M classinit: classinit: super 'c null dup put: dblAct put: act1 ;M
  154.  
  155. ;CLASS
  156.  
  157.  
  158. listWind Modwind
  159. 10 30 110 162 setrect: Modwind
  160. 3 9 setListFont: Modwind
  161. 68 setusage: Modwind    \ allow multiple clicks without a modifier key
  162. -10000 dup 10000 dup true setdrag: Modwind
  163.  
  164. sarray modList
  165.  
  166. : (.mod)  { theCfa size -- }  curs -curs theCfa  ?mod
  167.     IF  theCfa >name n>count
  168.         2dup " IMOD" s= not IF add: modList ELSE 2drop THEN
  169.     THEN  -> curs ;
  170.  
  171. \ list modules and their load status
  172. : .mods   'c (.mod)  0 trav  ;
  173.  
  174.  
  175. \ fills the list using names in ModList 
  176. : fillCol
  177.     false drawing: Modwind limit: modList 0
  178.     DO  i at: modList i putText: Modwind
  179.         i at: modList sfind
  180.         IF drop cfa ?keep
  181.             IF i hilite: modWind THEN
  182.         THEN
  183.     LOOP true drawing: Modwind ;
  184.  
  185. : prepList limit: ModList 0 addrows: Modwind fillCol ;
  186.  
  187. : buildModWind new: modList .mods 200 200 430 385 put: temprect
  188.     temprect " Modules" docWind false false new: ModWind
  189.     140 80 " Ok" modWind new: selectBut
  190.     140 110 " All" modWind new: AllBut
  191.     140 140 " None" modWind new: NoneBut
  192.     140 50 " Default" modWind new: defaultBut
  193.     -curs 1000 1000 gotoxy
  194.         size: modList
  195.         IF     prepList THEN show: modwind ;
  196.  
  197. : ModTitle -curs 0 tfont 12 tsize 10 19 gotoxy ." Select all mods to include…"
  198.     restoreFont: modWind ;
  199.  
  200. 4 'cfas null null modTitle errbeep actions: modwind
  201. 2 'cfas null null setact: modwind
  202.  
  203. 20 ordered-col nmods
  204.  
  205. : acceptSelect clear: nmods
  206.     nrows: modWind 0 DO i isCellSelected: modWind
  207.         IF i at: modList sfind 2drop cfa add: nmods THEN loop
  208.     close: modWind release: modList ;
  209.  
  210. : selectAll nrows: modWind 0 DO true i selectCell: modWind LOOP ;
  211. : selectNone nrows: modWind 0 DO false nrows: modWind i- 1-  selectCell: modWind LOOP ;
  212.  
  213. 'c acceptSelect actions: selectbut
  214. 'c selectAll actions: allBut
  215. 'c selectNone actions: noneBut
  216.  
  217. 6 ordered-col defaultMods
  218. 'c AlertMod add: defaultMods
  219. 'c indMod add: defaultMods
  220. 'c PrintMod add: defaultMods
  221. 'c sortMod add: defaultMods
  222. 'c aboutMod add: defaultMods
  223. 'c env add: defaultMods
  224.  
  225. : selectDefaults limit: modList 0
  226.     DO i at: modList sfind 2drop cfa indexof: defaultMods
  227.         IF drop true i selectCell: modWind  THEN
  228.     LOOP ;
  229.  
  230. 'c SelectDefaults actions: defaultBut
  231.